home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / MyHelp2124908272008.psc / KB Builder / frmEditTopic.frm < prev    next >
Text File  |  2008-08-27  |  19KB  |  540 lines

  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  3. Begin VB.Form frmEditTopic 
  4.    Caption         =   "Topic Properties"
  5.    ClientHeight    =   8520
  6.    ClientLeft      =   60
  7.    ClientTop       =   435
  8.    ClientWidth     =   7455
  9.    ClipControls    =   0   'False
  10.    ControlBox      =   0   'False
  11.    BeginProperty Font 
  12.       Name            =   "Tahoma"
  13.       Size            =   8.25
  14.       Charset         =   0
  15.       Weight          =   400
  16.       Underline       =   0   'False
  17.       Italic          =   0   'False
  18.       Strikethrough   =   0   'False
  19.    EndProperty
  20.    LinkTopic       =   "Form1"
  21.    ScaleHeight     =   8520
  22.    ScaleWidth      =   7455
  23.    StartUpPosition =   1  'CenterOwner
  24.    Begin VB.CommandButton cmdCancel 
  25.       Caption         =   "Done"
  26.       Height          =   375
  27.       Left            =   5880
  28.       TabIndex        =   9
  29.       Top             =   8040
  30.       Width           =   1335
  31.    End
  32.    Begin VB.CommandButton cmdOk 
  33.       Caption         =   "Apply"
  34.       Height          =   375
  35.       Left            =   4440
  36.       TabIndex        =   8
  37.       Top             =   8040
  38.       Width           =   1335
  39.    End
  40.    Begin VB.PictureBox fraTopic 
  41.       BorderStyle     =   0  'None
  42.       Height          =   7455
  43.       Left            =   0
  44.       ScaleHeight     =   7455
  45.       ScaleWidth      =   7215
  46.       TabIndex        =   18
  47.       Top             =   480
  48.       Width           =   7215
  49.       Begin VB.CheckBox chkPopup 
  50.          Caption         =   "Popup Page"
  51.          Height          =   255
  52.          Left            =   120
  53.          TabIndex        =   4
  54.          ToolTipText     =   "This topic will be displayed as a popup"
  55.          Top             =   1680
  56.          Width           =   1575
  57.       End
  58.       Begin VB.CommandButton DeleteFootNote 
  59.          Enabled         =   0   'False
  60.          Height          =   315
  61.          Left            =   6840
  62.          Picture         =   "frmEditTopic.frx":0000
  63.          Style           =   1  'Graphical
  64.          TabIndex        =   15
  65.          Top             =   6000
  66.          Width           =   255
  67.       End
  68.       Begin VB.CommandButton DeleteMacro 
  69.          Enabled         =   0   'False
  70.          Height          =   315
  71.          Left            =   6840
  72.          Picture         =   "frmEditTopic.frx":0102
  73.          Style           =   1  'Graphical
  74.          TabIndex        =   13
  75.          Top             =   4200
  76.          Width           =   255
  77.       End
  78.       Begin VB.CommandButton AddFootNote 
  79.          Height          =   315
  80.          Left            =   6840
  81.          Picture         =   "frmEditTopic.frx":0204
  82.          Style           =   1  'Graphical
  83.          TabIndex        =   14
  84.          Top             =   5640
  85.          Width           =   255
  86.       End
  87.       Begin VB.CommandButton AddMacro 
  88.          Height          =   315
  89.          Left            =   6840
  90.          Picture         =   "frmEditTopic.frx":0306
  91.          Style           =   1  'Graphical
  92.          TabIndex        =   12
  93.          Top             =   3840
  94.          Width           =   255
  95.       End
  96.       Begin VB.CheckBox chkBrowseSequence 
  97.          Caption         =   "Browse Sequence (recommended)"
  98.          Height          =   255
  99.          Left            =   120
  100.          TabIndex        =   3
  101.          Top             =   1320
  102.          Width           =   3855
  103.       End
  104.       Begin VB.CommandButton DeleteKeyword 
  105.          Enabled         =   0   'False
  106.          Height          =   315
  107.          Left            =   6840
  108.          Picture         =   "frmEditTopic.frx":0408
  109.          Style           =   1  'Graphical
  110.          TabIndex        =   11
  111.          Top             =   2400
  112.          Width           =   255
  113.       End
  114.       Begin VB.CommandButton AddKeyword 
  115.          Height          =   315
  116.          Left            =   6840
  117.          Picture         =   "frmEditTopic.frx":050A
  118.          Style           =   1  'Graphical
  119.          TabIndex        =   10
  120.          Top             =   2040
  121.          Width           =   255
  122.       End
  123.       Begin MSComctlLib.ListView lstKeywords 
  124.          Height          =   1695
  125.          Left            =   1560
  126.          TabIndex        =   5
  127.          Top             =   2040
  128.          Width           =   5295
  129.          _ExtentX        =   9340
  130.          _ExtentY        =   2990
  131.          View            =   3
  132.          LabelEdit       =   1
  133.          LabelWrap       =   -1  'True
  134.          HideSelection   =   -1  'True
  135.          HideColumnHeaders=   -1  'True
  136.          Checkboxes      =   -1  'True
  137.          FullRowSelect   =   -1  'True
  138.          GridLines       =   -1  'True
  139.          _Version        =   393217
  140.          ForeColor       =   -2147483640
  141.          BackColor       =   -2147483643
  142.          BorderStyle     =   1
  143.          Appearance      =   1
  144.          NumItems        =   1
  145.          BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  146.             Text            =   "Keyword(s)"
  147.             Object.Width           =   2540
  148.          EndProperty
  149.       End
  150.       Begin VB.TextBox txtContextNumber 
  151.          Height          =   315
  152.          Left            =   1560
  153.          TabIndex        =   2
  154.          Top             =   960
  155.          Width           =   1095
  156.       End
  157.       Begin VB.TextBox txtContextString 
  158.          Height          =   315
  159.          Left            =   1560
  160.          TabIndex        =   1
  161.          Top             =   600
  162.          Width           =   5535
  163.       End
  164.       Begin VB.TextBox txtTitle 
  165.          Height          =   315
  166.          Left            =   1560
  167.          TabIndex        =   0
  168.          Top             =   240
  169.          Width           =   5535
  170.       End
  171.       Begin MSComctlLib.ListView lstMacros 
  172.          Height          =   1695
  173.          Left            =   1560
  174.          TabIndex        =   6
  175.          Top             =   3840
  176.          Width           =   5295
  177.          _ExtentX        =   9340
  178.          _ExtentY        =   2990
  179.          View            =   3
  180.          LabelEdit       =   1
  181.          LabelWrap       =   -1  'True
  182.          HideSelection   =   -1  'True
  183.          HideColumnHeaders=   -1  'True
  184.          Checkboxes      =   -1  'True
  185.          FullRowSelect   =   -1  'True
  186.          GridLines       =   -1  'True
  187.          _Version        =   393217
  188.          ForeColor       =   -2147483640
  189.          BackColor       =   -2147483643
  190.          BorderStyle     =   1
  191.          Appearance      =   1
  192.          NumItems        =   1
  193.          BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  194.             Text            =   "Keyword(s)"
  195.             Object.Width           =   2540
  196.          EndProperty
  197.       End
  198.       Begin MSComctlLib.ListView lstFootNotes 
  199.          Height          =   1695
  200.          Left            =   1560
  201.          TabIndex        =   7
  202.          Top             =   5640
  203.          Width           =   5295
  204.          _ExtentX        =   9340
  205.          _ExtentY        =   2990
  206.          View            =   3
  207.          LabelEdit       =   1
  208.          LabelWrap       =   -1  'True
  209.          HideSelection   =   -1  'True
  210.          HideColumnHeaders=   -1  'True
  211.          Checkboxes      =   -1  'True
  212.          FullRowSelect   =   -1  'True
  213.          GridLines       =   -1  'True
  214.          _Version        =   393217
  215.          ForeColor       =   -2147483640
  216.          BackColor       =   -2147483643
  217.          BorderStyle     =   1
  218.          Appearance      =   1
  219.          NumItems        =   1
  220.          BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
  221.             Text            =   "Foot Note"
  222.             Object.Width           =   2540
  223.          EndProperty
  224.       End
  225.       Begin VB.Label lbl 
  226.          AutoSize        =   -1  'True
  227.          Caption         =   "A-Keywords"
  228.          Height          =   195
  229.          Index           =   6
  230.          Left            =   120
  231.          TabIndex        =   24
  232.          Top             =   5640
  233.          Width           =   870
  234.       End
  235.       Begin VB.Label lbl 
  236.          AutoSize        =   -1  'True
  237.          Caption         =   "Macro(s)"
  238.          Height          =   195
  239.          Index           =   5
  240.          Left            =   120
  241.          TabIndex        =   23
  242.          Top             =   3840
  243.          Width           =   630
  244.       End
  245.       Begin VB.Label lbl 
  246.          AutoSize        =   -1  'True
  247.          Caption         =   "K-Keyword(s)"
  248.          Height          =   195
  249.          Index           =   4
  250.          Left            =   120
  251.          TabIndex        =   22
  252.          Top             =   2040
  253.          Width           =   975
  254.       End
  255.       Begin VB.Label lbl 
  256.          AutoSize        =   -1  'True
  257.          Caption         =   "Context Number"
  258.          Height          =   195
  259.          Index           =   3
  260.          Left            =   120
  261.          TabIndex        =   21
  262.          Top             =   960
  263.          Width           =   1185
  264.       End
  265.       Begin VB.Label lbl 
  266.          AutoSize        =   -1  'True
  267.          Caption         =   "Context String"
  268.          Height          =   195
  269.          Index           =   2
  270.          Left            =   120
  271.          TabIndex        =   20
  272.          Top             =   600
  273.          Width           =   1050
  274.       End
  275.       Begin VB.Label lbl 
  276.          AutoSize        =   -1  'True
  277.          Caption         =   "Title"
  278.          Height          =   195
  279.          Index           =   1
  280.          Left            =   120
  281.          TabIndex        =   19
  282.          Top             =   240
  283.          Width           =   300
  284.       End
  285.    End
  286.    Begin VB.Label lblTopic 
  287.       AutoSize        =   -1  'True
  288.       BackStyle       =   0  'Transparent
  289.       Caption         =   "lblTopic"
  290.       ForeColor       =   &H000000FF&
  291.       Height          =   195
  292.       Left            =   720
  293.       TabIndex        =   17
  294.       Top             =   120
  295.       Width           =   525
  296.    End
  297.    Begin VB.Label lbl 
  298.       AutoSize        =   -1  'True
  299.       BackStyle       =   0  'Transparent
  300.       Caption         =   "Topic"
  301.       ForeColor       =   &H00FF0000&
  302.       Height          =   195
  303.       Index           =   0
  304.       Left            =   120
  305.       TabIndex        =   16
  306.       Top             =   120
  307.       Width           =   375
  308.    End
  309. End
  310. Attribute VB_Name = "frmEditTopic"
  311. Attribute VB_GlobalNameSpace = False
  312. Attribute VB_Creatable = False
  313. Attribute VB_PredeclaredId = True
  314. Attribute VB_Exposed = False
  315. Option Explicit
  316. Private StrAdd As String
  317. Private iAnswer As Integer
  318. Private Sub AddFootNote_Click()
  319.     On Error Resume Next
  320.     StrAdd = InputBox("Please type in the a-keywords to add below." & vbCr & "You can separate the a-keywords with a semicolon:", "Add A-Keyword(s)", Replace$(txtTitle.Text, " ", ";", , , vbTextCompare))
  321.     If Len(StrAdd) = 0 Then Exit Sub
  322.     AddKeyWords lstFootNotes, StrAdd
  323.     Err.Clear
  324. End Sub
  325. Private Sub AddKeyword_Click()
  326.     On Error Resume Next
  327.     StrAdd = InputBox("Please type in the k-keywords to add below." & vbCr & "You can separate the k-keywords with a semicolon:", "Add K-Keyword(s)", Replace$(txtTitle.Text, " ", ";", , , vbTextCompare))
  328.     If Len(StrAdd) = 0 Then Exit Sub
  329.     AddKeyWords lstKeywords, StrAdd
  330.     Err.Clear
  331. End Sub
  332. Private Sub AddMacro_Click()
  333.     On Error Resume Next
  334.     StrAdd = InputBox("Please type in the macro to add below.", "Add Macro")
  335.     If Len(StrAdd) = 0 Then Exit Sub
  336.     If LstViewFindItem(lstMacros, StrAdd, search_Text, search_Whole) = 0 Then
  337.         lstMacros.ListItems.Add , , StrAdd
  338.     End If
  339.     Err.Clear
  340. End Sub
  341. Private Sub cmdCancel_Click()
  342.     On Error Resume Next
  343.     Unload Me
  344.     Err.Clear
  345. End Sub
  346. Private Sub cmdOk_Click()
  347.     On Error Resume Next
  348.     If boolIsBlank(txtTitle, "topic title") = True Then Exit Sub
  349.     If boolIsBlank(txtContextString, "topic context string") = True Then Exit Sub
  350.     If boolIsBlank(txtContextNumber, "topic context number") = True Then Exit Sub
  351.     If lstKeywords.ListItems.Count = 0 Then
  352.         AddKeyWords lstKeywords, txtTitle.Text
  353.     End If
  354.     Dim rRecord(1 To 10) As String
  355.     Dim xLine() As String
  356.     Dim tPos As Long
  357.     rRecord(1) = lblTopic.Caption                                'FullPath
  358.     rRecord(2) = txtTitle.Text                                   'Title
  359.     rRecord(3) = Context_Validate(txtContextString.Text)           'Context
  360.     rRecord(4) = Val(txtContextNumber.Text)                      'Number
  361.     rRecord(5) = chkBrowseSequence.Value                         'Browse
  362.     LstViewRowsToMV lstKeywords, xLine, VM
  363.     rRecord(6) = MvFromArray(xLine, FM)
  364.     LstViewRowsToMV lstMacros, xLine, VM
  365.     rRecord(7) = MvFromArray(xLine, FM)
  366.     LstViewRowsToMV lstFootNotes, xLine, VM
  367.     rRecord(8) = MvFromArray(xLine, FM)
  368.     rRecord(10) = chkPopup.Value
  369.     Dao_WriteRecordArray sProjDb, "Properties", "FullPath", rRecord(1), PropertiesFlds, rRecord
  370.     DAO.DBEngine.Idle
  371.     If chkPopup.Value = 1 Then
  372.         tPos = TreeViewSearchPath(frmKB.treeDms, lblTopic.Caption)
  373.         If tPos > 0 Then
  374.             frmKB.treeDms.Nodes(tPos).Image = "leaf"
  375.             frmKB.treeDms.Nodes(tPos).SelectedImage = "leaf"
  376.             frmKB.treeChanged = True
  377.         End If
  378.     End If
  379.     Unload Me
  380.     Err.Clear
  381. End Sub
  382. Private Sub DeleteFootNote_Click()
  383.     On Error Resume Next
  384.     iAnswer = MsgBox("Are you sure that you want to delete the checked footnote(s).", vbYesNo + vbQuestion + vbApplicationModal, "Confirm Delete")
  385.     If iAnswer = vbNo Then Exit Sub
  386.     LstViewRemoveChecked lstFootNotes, True
  387.     Err.Clear
  388. End Sub
  389. Private Sub DeleteKeyword_Click()
  390.     On Error Resume Next
  391.     iAnswer = MsgBox("Are you sure that you want to delete the checked keyword(s).", vbYesNo + vbQuestion + vbApplicationModal, "Confirm Delete")
  392.     If iAnswer = vbNo Then Exit Sub
  393.     LstViewRemoveChecked lstKeywords, True
  394.     Err.Clear
  395. End Sub
  396. Private Sub DeleteMacro_Click()
  397.     On Error Resume Next
  398.     iAnswer = MsgBox("Are you sure that you want to delete the checked macros(s).", vbYesNo + vbQuestion + vbApplicationModal, "Confirm Delete")
  399.     If iAnswer = vbNo Then Exit Sub
  400.     LstViewRemoveChecked lstMacros, True
  401.     Err.Clear
  402. End Sub
  403. Private Sub lstFootNotes_ItemCheck(ByVal Item As MSComctlLib.ListItem)
  404.     On Error Resume Next
  405.     StrAdd = LstViewCheckedToMV(lstFootNotes, 1)
  406.     If Len(StrAdd) = 0 Then
  407.         DeleteFootNote.Enabled = False
  408.     Else
  409.         DeleteFootNote.Enabled = True
  410.     End If
  411.     Err.Clear
  412. End Sub
  413. Private Sub lstKeywords_ItemCheck(ByVal Item As MSComctlLib.ListItem)
  414.     On Error Resume Next
  415.     StrAdd = LstViewCheckedToMV(lstKeywords, 1)
  416.     If Len(StrAdd) = 0 Then
  417.         DeleteKeyword.Enabled = False
  418.     Else
  419.         DeleteKeyword.Enabled = True
  420.     End If
  421.     Err.Clear
  422. End Sub
  423. Private Sub lstMacros_ItemCheck(ByVal Item As MSComctlLib.ListItem)
  424.     On Error Resume Next
  425.     StrAdd = LstViewCheckedToMV(lstMacros, 1)
  426.     If Len(StrAdd) = 0 Then
  427.         DeleteMacro.Enabled = False
  428.     Else
  429.         DeleteMacro.Enabled = True
  430.     End If
  431.     Err.Clear
  432. End Sub
  433. Private Sub txtTitle_Change()
  434.     On Error Resume Next
  435.     txtContextString.Text = Context_Validate(txtTitle.Text)
  436.     Err.Clear
  437. End Sub
  438. Public Sub ReadTopicProperties(strPath As String)
  439.     On Error Resume Next
  440.     Dim rRecord() As String
  441.     rRecord = Dao_ReadRecordToArray(sProjDb, "Properties", "FullPath", strPath, PropertiesFlds)
  442.     ReDim Preserve rRecord(10)
  443.     txtTitle.Text = rRecord(2)                   'Title
  444.     txtContextString.Text = rRecord(3)           'Context
  445.     txtContextNumber.Text = rRecord(4)           'Number
  446.     chkBrowseSequence.Value = Val(rRecord(5))    'Browse
  447.     LstViewFromMv lstKeywords, rRecord(6), FM
  448.     LstViewFromMv lstMacros, rRecord(7), FM
  449.     LstViewFromMv lstFootNotes, rRecord(8), FM
  450.     chkPopup.Value = Val(rRecord(10))
  451.     Err.Clear
  452. End Sub
  453. Private Sub AddKeyWords(lstKeywords As ListView, ByVal StrKeywords As String)
  454.     On Error Resume Next
  455.     Dim spKeywords() As String
  456.     Dim spTot As Integer
  457.     Dim spCnt As Integer
  458.     StrKeywords = Replace$(StrKeywords, " ", ";")
  459.     spKeywords = Split(StrKeywords, ";")
  460.     spTot = UBound(spKeywords)
  461.     For spCnt = 0 To spTot
  462.         StrAdd = Trim$(spKeywords(spCnt))
  463.         If Len(StrAdd) = 0 Then GoTo NextKeyWord
  464.         If LstViewFindItem(lstKeywords, StrAdd, search_Text, search_Whole) = 0 Then
  465.             lstKeywords.ListItems.Add , , StrAdd
  466.         End If
  467. NextKeyWord:
  468.         Err.Clear
  469.     Next
  470.     Erase spKeywords
  471.     Err.Clear
  472. End Sub
  473. Public Function LstViewFindItem(lstView As ListView, ByVal StrSearch As String, Optional ByVal SearchWhere As FindWhere = search_Text, Optional SearchItemType As SearchType = search_Whole) As Long
  474.     On Error Resume Next
  475.     Dim itmFound As ListItem
  476.     LstViewFindItem = 0
  477.     Set itmFound = lstView.FindItem(StrSearch, SearchWhere, , SearchItemType)
  478.     If TypeName(itmFound) = "Nothing" Then
  479.         Err.Clear
  480.         Exit Function
  481.     End If
  482.     LstViewFindItem = CLng(itmFound.Index)
  483.     Set itmFound = Nothing
  484.     Err.Clear
  485. End Function
  486. Public Sub Dao_WriteRecordArray(ByVal Dbase As String, ByVal TableName As String, ByVal TableKey As String, ByVal ValuetoSeek As String, FieldsToRead As Variant, FieldsToWrite As Variant, Optional ByVal Overwrite As Boolean = True)
  487.     On Error Resume Next
  488.     If Len(ValuetoSeek) = 0 Then Exit Sub
  489.     Dim adoC As DAO.Database
  490.     Dim adoRs As DAO.Recordset
  491.     Dim spTot As Integer
  492.     Dim spCnt As Integer
  493.     Dim spFld As String
  494.     Set adoC = DAO.OpenDatabase(Dbase)
  495.     Set adoRs = adoC.OpenRecordset(TableName)
  496.     adoRs.Index = TableKey
  497.     adoRs.Seek "=", ValuetoSeek
  498.     spTot = UBound(FieldsToRead)
  499.     Select Case adoRs.NoMatch
  500.     Case True
  501.         adoRs.AddNew
  502.         dbConvertValue adoRs.Fields(TableKey), ValuetoSeek
  503.         For spCnt = 1 To spTot
  504.             spFld = FieldsToRead(spCnt)
  505.             dbConvertValue adoRs.Fields(spFld), FieldsToWrite(spCnt)
  506.             Err.Clear
  507.         Next
  508.         dbConvertValue adoRs.Fields(TableKey), ValuetoSeek
  509.         adoRs.Update
  510.     Case Else
  511.         Select Case Overwrite
  512.         Case False
  513.             adoRs.AddNew
  514.             dbConvertValue adoRs.Fields(TableKey), ValuetoSeek
  515.             For spCnt = 1 To spTot
  516.                 spFld = FieldsToRead(spCnt)
  517.                 dbConvertValue adoRs.Fields(spFld), FieldsToWrite(spCnt)
  518.                 Err.Clear
  519.             Next
  520.             dbConvertValue adoRs.Fields(TableKey), ValuetoSeek
  521.             adoRs.Update
  522.         Case True
  523.             adoRs.Edit
  524.             For spCnt = 1 To spTot
  525.                 spFld = FieldsToRead(spCnt)
  526.                 dbConvertValue adoRs.Fields(spFld), FieldsToWrite(spCnt)
  527.                 Err.Clear
  528.             Next
  529.             dbConvertValue adoRs.Fields(TableKey), ValuetoSeek
  530.             adoRs.Update
  531.         End Select
  532.     End Select
  533.     adoRs.Close
  534.     adoC.Close
  535.     Set adoC = Nothing
  536.     Set adoRs = Nothing
  537.     Err.Clear
  538. End Sub
  539.  
  540.